home *** CD-ROM | disk | FTP | other *** search
/ Delphi Magazine Collection 2001 / Delphi Magazine Collection 20001 (2001).iso / DISKS / Issue34 / construc / BERT.INC < prev    next >
Text File  |  1998-05-11  |  10KB  |  282 lines
  1. procedure GenerateContents(var Str: String);
  2. const
  3.   IniFile = '.\report.ini';
  4.  
  5.   procedure DataSetTable(DataSet: TDataSet; NewRec: Boolean);
  6.   { NEW RECORD - Actions: POST, CANCEL }
  7.   { BROWSE RECORD - Actions: FIRST, PREV, NEXT, LAST, INSERT, DELETE, REFRESH }
  8.   const
  9.     Int: Array[1..9] of Char = '123456789';
  10.   var
  11.     i,j,col,items: Integer;
  12.     option: ShortString;
  13.   begin
  14.   {$IFDEF DEBUG}
  15.     Str := Str + '<P>';
  16.     Str := Str + 'Debug Action: <INPUT TYPE=TEXT NAME=Action>'#13#10;
  17.     Str := Str + '<P>';
  18.   {$ENDIF}
  19.     if NewRec then
  20.     begin
  21.       Str := Str + '<INPUT TYPE=SUBMIT NAME=Action VALUE=Post>'#13#10;
  22.       Str := Str + '<INPUT TYPE=SUBMIT NAME=Action VALUE=Cancel>'#13#10
  23.     end
  24.     else
  25.     begin
  26.       Str := Str + '<INPUT TYPE=SUBMIT NAME=Action VALUE=First>'#13#10;
  27.       Str := Str + '<INPUT TYPE=SUBMIT NAME=Action VALUE=Prev>'#13#10;
  28.       Str := Str + '<INPUT TYPE=SUBMIT NAME=Action VALUE=Next>'#13#10;
  29.       Str := Str + '<INPUT TYPE=SUBMIT NAME=Action VALUE=Last>'#13#10;
  30.       Str := Str + ' '#13#10;
  31.       Str := Str + '<INPUT TYPE=SUBMIT NAME=Action VALUE=Insert>'#13#10;
  32.       Str := Str + '<INPUT TYPE=SUBMIT NAME=Action VALUE=Delete>'#13#10;
  33.       Str := Str + ' '#13#10;
  34.       Str := Str + '<INPUT TYPE=SUBMIT NAME=Action VALUE=Find>'#13#10;
  35.       Str := Str + '<INPUT TYPE=SUBMIT NAME=Action VALUE=Query>'#13#10;
  36.       Str := Str + ' '#13#10;
  37.       Str := Str + '<INPUT TYPE=SUBMIT NAME=Action VALUE=Refresh>'#13#10;
  38.     end;
  39.     Str := Str + '<INPUT TYPE=RESET VALUE=Reset>'#13#10;
  40.     Str := Str + '<P>'#13#10;
  41.     with DataSet do
  42.     begin
  43.       if NewRec then
  44.         Str := Str + '<INPUT TYPE=HIDDEN NAME="'+Fields[0].FieldName+
  45.                                '" VALUE="-1">'#13#10
  46.       else
  47.         Str := Str + '<INPUT TYPE=HIDDEN NAME="'+Fields[0].FieldName+
  48.                                '" VALUE="'+Fields[0].AsString+'">'#13#10;
  49.       Str := Str + '<TABLE BGCOLOR=BBBBBB BORDER><TR>'#13#10;
  50.       col := 0;
  51.       with TIniFile.Create(IniFile) do
  52.       try
  53.         for i:=1 to FieldCount-1 do { first field was hidden }
  54.         begin
  55.           if Fields[i].DataType = ftMemo then
  56.           begin
  57.             Str := Str + '</TR><TR><TD COLSPAN=3>';
  58.             col := 3;
  59.           end
  60.           else
  61.           if Fields[i].Size > 99 then
  62.           begin
  63.             Inc(col,2);
  64.             if col > 3 then
  65.             begin
  66.               Str := Str + '</TR><TR>';
  67.               col := 2
  68.             end;
  69.             Str := Str + '<TD COLSPAN=2>'
  70.           end
  71.           else
  72.           begin
  73.             Inc(col);
  74.             if col > 3 then
  75.             begin
  76.               Str := Str + '</TR>'#13#10'<TR>';
  77.               col := 1
  78.             end;
  79.             Str := Str + '<TD>'
  80.           end;
  81.           Str := Str + '<B>'+ReadString(Fields[i].FieldName,'Name',Fields[i].FieldName)+'</B><BR>';
  82.           items := ReadInteger(Fields[i].FieldName,'Items',0);
  83.           if items = 0 then
  84.           begin
  85.             if Fields[i].DataType = ftMemo then
  86.             begin
  87.               Str := Str + '<TEXTAREA NAME="'+Fields[i].FieldName+'" ROWS=6 COLS=72>';
  88.               if not NewRec then
  89.                 Str := Str + Fields[i].AsString;
  90.               Str := Str + '</TEXTAREA>'
  91.             end
  92.             else
  93.             begin
  94.               if Fields[i].Size > 99 then
  95.                 Str := Str + '<INPUT TYPE=text NAME="'+Fields[i].FieldName+'" SIZE=64'
  96.               else
  97.                 if Fields[i].Size = 0 then
  98.                   Str := Str + '<INPUT TYPE=text NAME="'+Fields[i].FieldName+'" SIZE=30'
  99.                 else
  100.                   Str := Str + '<INPUT TYPE=text NAME="'+Fields[i].FieldName+'" SIZE='+IntToStr(Fields[i].Size);
  101.               if not NewRec then
  102.                 Str := Str + ' VALUE="'+Fields[i].AsString+'"';
  103.               Str := Str + '>'
  104.             end
  105.           end
  106.           else
  107.           begin
  108.             Str := Str + '<SELECT NAME="'+Fields[i].FieldName+'">';
  109.             for j:=1 to items do
  110.             begin
  111.               option := ReadString(Fields[i].FieldName,'Item'+Int[j],Int[j]);
  112.               if (not NewRec) and (option = Fields[i].AsString) then { selected }
  113.                 Str := Str + '<OPTION SELECTED VALUE="'+option+'">'+option+' '
  114.               else
  115.                 Str := Str + '<OPTION VALUE="'+option+'">'+option+' '
  116.             end;
  117.             Str := Str + '</SELECT>'
  118.           end;
  119.           Str := Str + '</TD>'
  120.         end;
  121.         Str := Str + '</TR>'#13#10
  122.       finally
  123.         Str := Str + '</TABLE>'#13#10;
  124.         Free
  125.       end
  126.     end
  127.   end;
  128.  
  129. const
  130.   _DatabaseName = ''; { no alias: current directory }
  131.   _TableName = 'report.db';
  132.   Action: String[7] = '';
  133. var
  134.   Table: TTable;
  135.   Session: TSession; { IMPORTANT }
  136.   Report,i: Integer; { key field }
  137.   NoChange: Boolean;
  138. begin
  139.   Str := '';
  140.   Action := '';
  141.   ShortDateFormat := 'DD/MM/YYYY';
  142.   GetDir(0,Str);
  143.   if IOResult <> 0 then { skip };
  144.   Str := Str + '<HTML>'#13#10;
  145.   with TIniFile.Create(IniFile) do
  146.   try
  147.     Str := Str + '<HEAD>'#13#10;
  148.     Str := Str + '<TITLE>'+ReadString(_TableName,'Name','')+'</TITLE>'#13#10;
  149.     Str := Str + '</HEAD>'#13#10;
  150.     Str := Str + '<BODY BGCOLOR=AAAAAA>'#13#10;
  151.     Str := Str + '<CENTER>'#13#10;
  152.     Str := Str + '<H1>';
  153.     Str := Str + '<IMG SRC="'+ReadString(_TableName,'Bitmap','')+'">';
  154.     Str := Str + ReadString(_TableName,'Name','');
  155.     Str := Str + '</H1>'#13#10;
  156.     Str := Str + '<FORM METHOD=POST ACTION="'+ReadString(_TableName,'Action','')+'">'#13#10
  157.   finally
  158.     Free
  159.   end;
  160.   // IMPORTANT
  161.   Session := TSession.Create(nil);
  162.   Session.AutosessionName := True;
  163.   Session.Active := True;
  164.   // IMPORTANT
  165.   Table := TTable.Create(nil);
  166.   Table.SessionName := Session.SessionName;
  167.   with Table do
  168.   try
  169.     Active := False;
  170.     TableType := ttParadox;
  171.   { DatabaseName := _DatabaseName; }
  172.     TableName := _TableName;
  173.     Open;
  174.     First;
  175.     { locate current record }
  176.     Report := ValueAsInteger('Report');
  177.     if Report > 0 then FindKey([Report])
  178.                   else First;
  179.     { update record if data has changed }
  180.     NoChange := True; { assume no change }
  181.     if (Value('_'+Fields[0].FieldName) <> '') and { old data is stored }
  182.        (ValueAsInteger(Fields[0].FieldName) <> -1) then
  183.     begin
  184.       NoChange := True; { assume no change }
  185.       for i:=0 to FieldCount-1 do
  186.         NoChange := NoChange AND
  187.          (Value('_'+Fields[i].FieldName) = Value(Fields[i].FieldName));
  188.       if not NoChange then { update record }
  189.       begin
  190.         { check if data in table is still the same }
  191.         NoChange := True;
  192.         for i:=0 to FieldCount-1 do
  193.           NoChange := NoChange AND
  194.            (Value('_'+Fields[i].FieldName) = Fields[i].AsString);
  195.         if not NoChange then { table changed!! }
  196.         begin
  197.           Str := Str + '<B>Error: value of record changed before your update was made!</B>';
  198.           Action := 'Refresh' { force refresh }
  199.         end
  200.         else { go ahead! }
  201.         begin
  202.           Str := Str + '<FONT SIZE=2>Note: ';
  203.           Edit; { set Table in Edit-mode }
  204.           for i:=0 to FieldCount-1 do
  205.           begin
  206.             if (Value('_'+Fields[i].FieldName) <> Value(Fields[i].FieldName)) then
  207.             begin
  208.             {$IFDEF DEBUG}
  209.               Str := Str + IntToStr(i)+' ['+Value('_'+Fields[i].FieldName)+']-{'+Value(Fields[i].FieldName)+'} ';
  210.             {$ENDIF}
  211.               Fields[i].AsString := Value(Fields[i].FieldName) { new }
  212.             end
  213.           end;
  214.           Post { Post data in Table };
  215.           Str := Str + ' previous record updated in table</FONT><P>'#13#10
  216.         end
  217.       end
  218.     end;
  219.     { determine action }
  220.     if Action = '' then
  221.       Action := Value('Action');
  222.     if Action = '' then Action := 'First';
  223.     { perform action }
  224.     if Action = 'First' then First
  225.     else
  226.     if Action = 'Next' then Next
  227.     else
  228.     if Action = 'Prev' then Prior
  229.     else
  230.     if Action = 'Last' then Last
  231.     else
  232.     if (Action = 'Find') or (Action = 'Query') then
  233.     begin
  234.       // TODO: special query CGI-Form
  235.     end
  236.     else
  237.     if Action = 'Delete' then Delete
  238.     else
  239.     if Action = 'Insert' then { skip }
  240.     else
  241.     if Action = 'Post' then { insert record }
  242.     begin
  243.       First;
  244.       Report := 0;
  245.       while not Eof do
  246.       begin
  247.         if Fields[0].AsInteger > Report then Report := Fields[0].AsInteger;
  248.         Next
  249.       end;
  250.       Inc(Report);
  251.       Insert;
  252.       Fields[0].AsInteger := Report;
  253.       for i:=1 to FieldCount-1 do
  254.         Fields[i].AsString := Value(Fields[i].FieldName);
  255.       Post
  256.     end
  257.     else
  258.     if Action = 'Cancel' then { cancel }
  259.     else
  260.       { Refresh };
  261.     Str := Str + '<P><B>' + Action + '</B><P>';
  262.     for i:=0 to FieldCount-1 do
  263.       Str := Str + '<INPUT TYPE=HIDDEN NAME="_'+Fields[i].FieldName+
  264.                                     '" VALUE="'+Fields[i].AsString+'">'#13#10;
  265.     Str := Str + Fields[0].AsString+' - '+IntToStr(RecNo)+
  266.                                       '/'+IntToStr(RecordCount)+'  '#13#10;
  267.     { generate HTML CGI-Form with fields }
  268.     DataSetTable(Table,Action = 'Insert');
  269.     Close
  270.   finally
  271.     Str := Str + '</FORM>'#13#10;
  272.     Str := Str + '</BODY>'#13#10;
  273.     Str := Str + '</HTML>'#13#10;
  274.     Free
  275.   end;
  276.   // IMPORTANT
  277.   Session.Free;
  278.   Session := nil;
  279.   // IMPORTANT
  280.   Table := nil
  281. end;
  282.